home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Interactive 7
/
PC World Interactive 7.iso
/
program
/
qbprog.EXE
/
SESBUL.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-09-27
|
6KB
|
243 lines
'Ses kartìnìn adresi ve kullandìºì IRQ'yu kesinlikle bulur
'Sadece SoundBlaster ve %100 uyumlu kartlarda geçerlidir
'QBASIC'de çalìƒìr
'QBX de çalìƒmasì için QBX /L QBX ƒeklinde
'QB de çalìƒmasì için QB /L QB ƒeklinde baƒlanmalìdìr.
DIM Sakla(26), Adres(6)
Adres(1) = &H210
Adres(2) = &H220
Adres(3) = &H230
Adres(4) = &H240
Adres(5) = &H250
Adres(6) = &H260
GOSUB KesmeVektorSakla
GOSUB PicSakla
GOSUB YeniKesmeYap
GOSUB IRQlerinHepsiAktifOlsun
COLOR 7, 1
CLS
FOR I = 1 TO 6
GOSUB Seskartara
NEXT
GOSUB IRQlerEskiHalineGelsin
GOSUB KesmeVektorleriEskiHalineGelsin
IF Sbase = 0 THEN PRINT "Sistemde ses kartì yok...": END
GOSUB SesYap
END
SesYap:
'Gong sesi üretiliyor
Port = Sbase + &HC
FOR A = 1 TO 2
FOR I = 1 TO 127
FOR Y = 1 TO 2
Deger = I
GOSUB SesVer
Deger = 255 - I
GOSUB SesVer
NEXT
NEXT
NEXT
RETURN
SesVer:
DO
IF INP(Port) AND 128 <> 0 THEN EXIT DO
LOOP
OUT Port, 16
OUT Port, Deger
RETURN
KesmeVektorSakla:
'ÿnterrupt (IRQ=2,3,4,5,7 INT=A,B,C,D,F) vektor adresleri saklanìyor
DEF SEG = 0
FOR I = 40 TO 63
Sakla(I - 39) = PEEK(I)
NEXT
RETURN
PicSakla:
'ÿnterrupt Kontrolör (PIC) deºeri saklanìyor
Sakla(25) = INP(&H21)
Sakla(26) = INP(&HA1)
RETURN
YeniKesmeYap:
'Yeni interrupt rutinleri yerleƒtiriliyor
FOR Y = 2 TO 7
IF Y <> 6 THEN
DEF SEG = &HB900
RESTORE YeniKesme
B = (Y - 2) * 20 + 11
FOR I = B TO B + 17
READ A
POKE I, A
NEXT
POKE B + 9, Y
DEF SEG = 0
C = 32 + Y * 4
POKE C, B
POKE C + 1, 0
POKE C + 2, 0
POKE C + 3, &HB9
END IF
NEXT
RETURN
IRQlerinHepsiAktifOlsun:
'ÿnterrupt yazmacì (PIC) IRQ'larìn çalìƒmasì için ayarlanìyor
'IRQ6 Dìƒìnda bütün IRQ'lar aktifleƒtiriliyor.(yani IRQ2,3,4,5,7)
FOR Y1 = 2 TO 7
IF Y1 <> 6 THEN
RESTORE IRQSerbest
REDIM Oku(44)
DEF SEG = VARSEG(Oku(0))
FOR PicMask = 0 TO 44
READ D%
IF PicMask = 13 THEN D% = Y1
POKE VARPTR(Oku(0)) + PicMask, D%
NEXT PicMask
CALL ABSOLUTE(VARPTR(Oku(0)))
END IF
NEXT
RETURN
IRQlerEskiHalineGelsin:
'ÿnterrupt yazmacìna eski IRQ deºerleri iade ediliyor
OUT &H21, Sakla(25)
OUT &HA1, Sakla(26)
RETURN
KesmeVektorleriEskiHalineGelsin:
'Eski interrupt adresleri iade ediliyor
DEF SEG = 0
FOR I = 40 TO 63
POKE I, Sakla(I - 39)
NEXT
RETURN
Seskartara:
GOSUB AdresleriTemizle
Taban = Adres(I)
GOSUB SesKartTetikle
GOSUB SesKartVarveyaYok
COLOR 7, 1
LOCATE I, 1
PRINT HEX$(Adres(I)); " Adresinde ";
IF Var = 0 THEN
PRINT "Ses kartì bulunamadì"
ELSE
COLOR 14, 1
PRINT "Ses kartì bulundu, ";
Sbase = Adres(I)
GOSUB IRQAktifle
GOSUB IRQOlustumu
IF IRQ = 0 THEN
PRINT "IRQ anlaƒìlamadì !!"
ELSE
PRINT "IRQ="; IRQ; " kullanìyor..."
END IF
END IF
RETURN
AdresleriTemizle:
'ÿnterruptlarìn yazacaºì offsetler temizleniyor
DEF SEG = &HB900
FOR Y = 2 TO 7
POKE Y, 0
NEXT
RETURN
SesKartTetikle:
'ÿlk deºerler gönderiliyor
A = INP(Taban + &HE)
OUT Taban + 6, 1
A = INP(Taban + 6)
A = INP(Taban + 6)
A = INP(Taban + 6)
OUT Taban + 6, 0
RETURN
SesKartVarveyaYok:
Var = 0
FOR Y3 = 1 TO 10
IF INP(Taban + &HE) AND 128 <> 0 THEN
IF INP(Taban + &HA) = 170 THEN
Var = 1
EXIT FOR
END IF
END IF
NEXT Y3
RETURN
IRQAktifle:
'IRQ'nun aktif olmasì için port tetikleniyor
FOR Z = 1 TO 10
IF INP(Taban + &HC) OR INP(Taban + &HC) <> 0 THEN
OUT Taban + &HC, &HF2
END IF
NEXT
RETURN
IRQOlustumu:
'ÿnterrupt offsetlerine bakìlìyor, Kesme oluƒmuƒ mu?
IRQ = 0
DEF SEG = &HB900
FOR Y = 2 TO 7
IF PEEK(Y) <> 0 THEN IRQ = Y
NEXT
RETURN
'Yeni interrupt rutini
YeniKesme:
DATA &H50 : 'PUSH AX
DATA &H1E : 'PUSH DS
DATA &HB8, 0, &HB9 : 'MOV AX, B900
DATA &H8E, &HD8 : 'MOV DS, AX
DATA &H88, &H26, 2, 0 : 'MOV [0002], AH
DATA &HB0, &H20 : 'MOV AL,20
DATA &HE6, &H20 : 'MOV 20,AL
DATA &H1F : 'POP DS
DATA &H58 : 'POP AX
DATA &HCF : 'IRET
'ÿnterrupt Kontrol Yazmacìnìn IRQ'ya izin verme rutini
IRQSerbest:
DATA &H50 : 'PUSH AX
DATA &H53 : 'PUSH BX
DATA &H51 : 'PUSH CX
DATA &H1E : 'PUSH DS
DATA &HFA : 'CLI
DATA &HB8, 0, &HB9 : 'MOV AX,B900
DATA &H8E, &HD8 : 'MOV DS,AX
DATA &H31, &HC9 : 'XOR CX,CX
DATA &HB1, 2 : 'MOV CL,02
DATA &HBB, 1, 0 : 'MOV BX,0001
DATA &HD3, &HE3 : 'SHL BX,CL
DATA &HF7, &HD3 : 'NOT BX
DATA &HE4, &HA1 : 'IN AL,A1
DATA &HA2, 0, 0 : 'MOV [0000],AL
DATA &H20, &HF8 : 'AND AL,BH
DATA &HE6, &HA1 : 'OUT A1,AL
DATA &HE4, &H21 : 'IN AL,21
DATA &HA2, 1, 0 : 'MOV [0001],AL
DATA &H20, &HD8 : 'AND AL,BL
DATA &HE6, &H21 : 'OUT 21,AL
DATA &HFB : 'STI
DATA &H1F : 'POP DS
DATA &H59 : 'POP CX
DATA &H5B : 'POP BX
DATA &H58 : 'POP AX
DATA &HCB : 'RETF